home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / read.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  24.9 KB  |  836 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #define GEN
  11.  
  12. #include "hdr.h"
  13. #include "libhdr.h"
  14. #include "vars.h"
  15. #include "segment.h"
  16. #include "gvars.h"
  17. #include "slot.h"
  18. #include "ifile.h"
  19. #include "axqrprots.h"
  20. #include "axqwprots.h"
  21. #include "libwprots.h"
  22. #include "gutilprots.h"
  23. #include "gmiscprots.h"
  24. #include "gmainprots.h"
  25. #include "libfprots.h"
  26. #include "librprots.h"
  27. #include "setprots.h"
  28. #include "libprots.h"
  29. #include "miscprots.h"
  30. #include "readprots.h"
  31.  
  32. #ifdef vms
  33. #ifdef BINDER
  34. #define vms_BINDER
  35. #endif
  36. #endif
  37.  
  38. #ifdef vms_BINDER
  39. /*
  40. #include "adabind.h"
  41. #include descrip
  42. */
  43. #endif
  44.  
  45. static void get_local_ref_maps(IFILE *, int);
  46. static void put_local_ref_maps(IFILE *, int);
  47. static void relocate_slots_a();
  48. static void relocate_slots_b();
  49. static void overwrite_stub_name(char *);
  50.  
  51. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  52. extern IFILE *AXQFILE, *LIBFILE, *AISFILE, *STUBFILE;
  53.  
  54. static Tuple code_slots_syms, data_slots_syms;
  55.  
  56. /* Input/Output of compiler files */
  57.  
  58. int load_unit(char *unit, int tree_is_needed)                    /*;load_unit*/
  59. {
  60.     /*
  61.      * Retrieves the symbol table of the given unit and puts its information
  62.      * into the compilation maps.
  63.      * An AXQ may be read from the library if the unit has not yet been
  64.      * loaded. If the file cannot be opened, or the unit is not found, an
  65.      * error message is printed.
  66.      * BEWARE: the loaded AXQ may contain an unit with the same name as the
  67.      * current one, that must not be loaded, as its symbol table would
  68.      * override the current one.
  69.      */
  70.  
  71.     char    *fname;
  72.     int        file_retrieved;
  73.     Symbol    unit_unam;
  74.     Tuple    decmaps, decscopes, s_info;
  75.     Unitdecl    ud;
  76.  
  77.     fname = lib_unit_get(unit);
  78. #ifdef TRACE
  79.     if (debug_flag) gen_trace(strjoin("load_unit ", unit));
  80. #endif
  81.     if (fname == (char *)0) {
  82.         user_error(strjoin(formatted_name(unit), " not present in library"));
  83.         return FALSE;
  84.     }
  85.     else if (in_aisunits_read(unit)) {
  86.         file_retrieved = TRUE;
  87.     }
  88.     else {
  89.         file_retrieved = 
  90.           (read_ais(fname, FALSE, unit, 0, tree_is_needed) != (char *)0);
  91.  
  92.         if (is_subunit(unit)) read_stub(lib_unit_get(unit), unit, "st2");
  93. #ifdef TBSL
  94.         if (is_subunit(unit)) {
  95.             /* If the subunit  has been  compiled, its  stub environment 
  96.                 * overrides the one appearing in the axq of the parent unit.
  97.              */
  98.             (for [n, env] in axqt) STUB_ENV(n) : = env; 
  99.             end ;
  100.         }
  101.         else {
  102.             STUB_ENV +: = axqt;
  103.         }
  104. #endif
  105.     }
  106.  
  107.     if (file_retrieved && (ud = unit_decl_get(unit)) != (Unitdecl)0) {
  108.         /* [unit_unam, s_info, decls] = UNIT_DECL(unit); */
  109.         unit_unam = ud->ud_unam;
  110.         s_info = ud->ud_symbols;
  111.         decscopes = ud->ud_decscopes;
  112.         decmaps = ud->ud_decmaps;
  113.         /* TBSL does the info from decscopes and decmaps need to be restored 
  114.          * or is the info restored by symtab_restore since declared info is 
  115.          * stored with the symbols.
  116.          * DECLARED  += decls; 
  117.          * SYMBTABQ restore 
  118.          */
  119.         symtab_restore(s_info);
  120.         return TRUE;
  121.     }
  122.     else {
  123.         user_error(strjoin("Cannot retrieve unit ", formatted_name(unit)));
  124.         user_info(strjoin(" from file ", fname));
  125.         return FALSE;
  126.     }
  127. }
  128.  
  129.  
  130. void load_library(Axq axq)                                    /*;load_library*/
  131. {
  132.     /*
  133.      * retrieve information from LIBFILE
  134.      * Called only not newlib.
  135.      */
  136.  
  137.     int        comp_status, si, i, j, n, m, unumber, nodes, symbols, cur_level;
  138.     int        parent, unit_count;
  139.     Tuple    stubtup, tup;
  140.     char    *parent_name, *uname, *aisname, *tmp_str, *compdate;
  141.     Set        precedes;
  142.     int        n_code_slots, n_data_slots, n_exception_slots;
  143.     long    cde_pos; /* offset for start of slot info */
  144.     IFILE    *ifile;
  145.  
  146.     ifile = LIBFILE;
  147.     /* library already opened */
  148.     unit_count = getnum(ifile, "lib-unit-count");
  149.     n = getnum(ifile, "lib-n");
  150.     empty_unit_slots = getnum(ifile, "lib-empty-slots");
  151.     tmp_str = getstr(ifile, "lib-tmp-str");
  152.     unit_number_expand(n);
  153.     for (i = 1; i <= unit_count; i++) {
  154.         struct unit *pUnit;
  155.         uname = getstr(ifile, "lib-unit-name");
  156.         unumber = getnum(ifile, "lib-unit-number");
  157.         aisname = getstr(ifile, "lib-ais-name");
  158.         compdate = getstr(ifile, "comp-date");
  159.         symbols = getnum(ifile, "lib-symbols");
  160.         nodes = getnum(ifile, "lib-nodes");
  161.         pUnit = pUnits[unumber];
  162.         pUnit->name = strjoin(uname, "");
  163.         pUnit->isMain = getnum(ifile, "lib-is-main");
  164.         pUnit->libInfo.fname = strjoin(aisname, "");
  165.         pUnit->libInfo.compDate = compdate;
  166.         comp_status = getnum(ifile, "lib-status");
  167.         pUnit->libInfo.obsolete = (comp_status) ? "ok" : "$D$";
  168.         pUnit->libUnit = (comp_status) ? strjoin(uname, "") : "$D$";
  169.         pUnit->aisInfo.numberSymbols = symbols;
  170.         pUnit->treInfo.nodeCount = nodes;
  171.         pUnit->treInfo.tableAllocated = (char *) tup_new(0);
  172.     }
  173.     n = getnum(ifile, "lib-n");
  174.     for (i = 1; i <= n; i++) {
  175.         uname = getstr(ifile, "lib-unit-name");
  176.         aisname = getstr(ifile, "lib-ais-name");
  177.         lib_stub_put(uname, aisname);
  178.         parent = getnum(ifile, "lib-parent");
  179.         if (parent == 0) parent_name = " ";
  180.         else parent_name = pUnits[parent]->name;
  181.         stub_parent_put(uname, parent_name);
  182.         cur_level = getnum(ifile, "lib-cur-level");
  183.         current_level_put(uname, cur_level);
  184.         si = stub_numbered(uname);
  185.         stubtup = (Tuple) stub_info[si];
  186.         m = getnum(ifile, "stub-file-size");
  187.         tup = tup_new(m);
  188.         for (j = 1; j <= m; j++)
  189.             tup[j] = (char *) getnum(ifile, "stub-files");
  190.         stubtup[4] = (char *) tup;
  191.     }
  192.     n = getnum(ifile, "precedes-map-size");
  193.     PRECEDES_MAP = tup_new(n);
  194.     for (i = 1; i <= n; i += 2) {
  195.         PRECEDES_MAP[i] = (char *) getnum(ifile, "precedes-map-ent");
  196.         m = getnum(ifile, "precedes-map-set-size");
  197.         precedes = set_new(m);
  198.         for (j = 1; j <= m; j++) {
  199.             precedes = set_with(precedes,
  200.               (char *) getnum(ifile, "precedes-map-ent"));
  201.         }
  202.         PRECEDES_MAP[i+1] = (char *) precedes;
  203.     }
  204.     n = getnum(ifile, "compilation_table_size");
  205.     compilation_table = tup_new(n);
  206.     for (i = 1; i <= n; i++)
  207.         compilation_table[i] = (char *) getnum(ifile, "compilation-table-ent");
  208.     /* late_instances */
  209.     n = getnum(ifile, "late-instances-size");
  210.     late_instances = tup_new(n);
  211.     for (i = 1; i <= n; i++)
  212.         late_instances[i] = getstr(ifile, "late-instances-str");
  213.     n = getnum(ifile, "interfaced-procedures-size");
  214.     interfaced_procedures = tup_new(n);
  215.     for (i = 1; i <= n; i += 2) {
  216.         interfaced_procedures[i] =
  217.           (char *) getnum(ifile, "interfaced-procedures-num");
  218.         interfaced_procedures[i+1]= getstr(ifile, "interfaced-procedures-str");
  219.     }
  220.     interface_counter = getnum(ifile, "interface-counter");
  221.     n = getnum(ifile, "units-size");
  222.     for (i = 1; i <= n; i++) {
  223.         pUnits[i]->libInfo.currCodeSeg =
  224.           (char *) getnum(ifile, "current-code-seg");
  225.     }
  226.     n = getnum(ifile, "units-size");
  227.     /* read local_reference_map for each unit (tuple of symbols and offsets) */
  228.     get_local_ref_maps(LIBFILE, n);
  229.     cde_pos = get_cde_slots(LIBFILE, axq);
  230.     /* Now set CODE_SLOTS, DATA_SLOTS and EXCEPTION_SLOTS from axq */
  231.     n_code_slots = axq->axq_code_slots_dim -1;
  232.     n_data_slots = axq->axq_data_slots_dim - 1;
  233.     n_exception_slots = axq->axq_exception_slots_dim - 1;
  234.     CODE_SLOTS = tup_new(n_code_slots);
  235.     for (i = 1; i <= n_code_slots; i++) {
  236.         CODE_SLOTS[i] = (char *) axq->axq_code_slots[i];
  237.     }
  238.     DATA_SLOTS = tup_new(n_data_slots);
  239.     for (i = 1; i <= n_data_slots; i++) {
  240.         DATA_SLOTS[i] = (char *) axq->axq_data_slots[i];
  241.     }
  242.     EXCEPTION_SLOTS = tup_new(n_exception_slots);
  243.     for (i = 1; i <= n_exception_slots; i++) {
  244.         EXCEPTION_SLOTS[i] = (char *) axq->axq_exception_slots[i];
  245.     }
  246.     /* could free axq_data_slots, etc., but keep for now */
  247.     /* read out LIB_STUB map (always empty for now) */
  248.     ifclose(LIBFILE);
  249.     return;
  250. }
  251.  
  252. void store_axq(IFILE *file, int unit_num)                        /*;store_axq*/
  253. {
  254.     /* Writes the AXQ file of compiled units (symmetrical to LOAD_AIS) */
  255.  
  256.     int        si, i, n, symbols, slots_ind, nsegs;
  257.     long    begpos;
  258.     Tuple    u_slots, symtup, tup;
  259.     Symbol    sym;
  260.     Segment    seg;
  261.     Fortup    ft1;
  262.     Forset    fs1;
  263.     extern    char iot_ofile_type;
  264.     char    *uname;
  265.     Stubenv    ev;
  266.     IFILE    *ofile;
  267.  
  268. #ifdef TRACE
  269.     if (debug_flag) gen_trace_string("STORE_AXQ: ", pUnits[unit_num]->name);
  270. #endif
  271.  
  272.     /* In order to make the sequence of symbols written out dense (consecutive)
  273.      * without holes, the new symbols which are needed externally, namely 
  274.      * GENERATED_OBJECTS have their seq numbers renumbed before being written
  275.      * out. This new ordering begins right after the sequence number of the last
  276.      * symbol read in from the semantic phase.
  277.      */
  278.     pUnits[unit_num]->libInfo.compDate = (char *)greentime(0);
  279.     n = (GENERATED_OBJECTS == (Tuple)0) ? 0 : tup_size(GENERATED_OBJECTS);
  280.     symbols = pUnits[unit_num]->aisInfo.numberSymbols;
  281.     relocate_slots_a();
  282.     for (i = 1; i <= n; i++) {
  283.         sym = (Symbol) GENERATED_OBJECTS[i];
  284.         S_SEQ(sym) = symbols + i;
  285.         seq_symbol[symbols + i] = (char *) sym;
  286.     }
  287.     seq_symbol_n = symbols + n;
  288.     relocate_slots_b();
  289.     AISFILE = AXQFILE;
  290.     begpos = write_ais(unit_num);
  291.     ofile = AXQFILE;
  292.  
  293.     if (n > 0) {
  294.         symtup = (Tuple)pUnits[unit_num]->aisInfo.symbols;
  295.         symtup = tup_exp(symtup, symbols + n);
  296.         for (i = 1; i <= n; i++) 
  297.             symtup[i+symbols] = (char *) GENERATED_OBJECTS[i];
  298.         pUnits[unit_num]->aisInfo.symbols = (char *) symtup;
  299.     }
  300.  
  301.  
  302.     u_slots = unit_slots_get(unit_num);
  303.     /* put out data slots info */
  304.     for (slots_ind = 1; slots_ind <= 4; slots_ind += 3) {
  305.         tup = (Tuple) u_slots[slots_ind];
  306.         nsegs  = 0; /* first count number of defined segments */
  307.         FORTUP(i = (int), tup , ft1)
  308.             seg = segment_map_get(DATA_SEGMENT_MAP, i);
  309.             if (seg != (Segment)0)
  310.                 nsegs++;
  311.         ENDFORTUP(ft1);
  312.         putnum(ofile, "number-segments", nsegs);
  313.         FORTUP(i = (int), tup , ft1)
  314.             seg = segment_map_get(DATA_SEGMENT_MAP, i);
  315.             if (seg != (Segment)0) {
  316.                 putnum(ofile, "segment-number", i);
  317.                 segment_write(AXQFILE, seg);
  318.             }
  319.         ENDFORTUP(ft1);
  320.     }
  321.     /* put out code slots info */
  322.     for (slots_ind = 2; slots_ind <= 5; slots_ind += 3) {
  323.         nsegs = 0;
  324.         FORTUP(i = (int), (Tuple) u_slots[slots_ind], ft1)
  325.             seg = segment_map_get(CODE_SEGMENT_MAP, i);
  326.             if (seg != (Segment)0)
  327.                 nsegs++;
  328.         ENDFORTUP(ft1);
  329.         putnum(ofile, "number-segments", nsegs);
  330.         FORTUP(i = (int), (Tuple) u_slots[slots_ind], ft1)
  331.             seg = segment_map_get(CODE_SEGMENT_MAP, i);
  332.             if (seg != (Segment)0) {
  333.                 putnum(ofile, "slot-number", i);
  334.                 segment_write(AXQFILE, seg);
  335.             }
  336.         ENDFORTUP(ft1);
  337.     }
  338.  
  339.     write_end(ofile, begpos);
  340.     uname = pUnits[unit_num]->name;
  341.     if (is_subunit(uname) &&!is_generic(uname)) {
  342.         si = stub_numbered(uname);
  343.         tup = (Tuple) stub_info[si];
  344.         ev = (Stubenv)tup[2];
  345.         update_stub(ev);
  346.         if (streq(lib_stub_get(uname), AISFILENAME)) overwrite_stub_name(uname);
  347.         write_stub(ev, uname, "st2");
  348.         /* lib_stub_put(uname, AISFILENAME); */
  349.     }
  350.     FORSET(si = (int), stubs_to_write, fs1);
  351.         tup = (Tuple)stub_info[si];
  352.         ev = (Stubenv)tup[2];
  353.         write_stub(ev, lib_stub[si], "st2");
  354.     ENDFORSET(fs1);
  355.     stubs_to_write = set_new(0);
  356. }
  357.  
  358. static void get_local_ref_maps(IFILE *ifile, int units)    /*;get_local_ref_map*/
  359. {
  360.     int        unit, defined, i, off, n;
  361.     Symbol    sym;
  362.     Tuple    local_ref_map;
  363.  
  364.     for (unit = 1; unit <= units; unit++) {
  365.         /* ignore empty ref maps (predef units) and obselete units */
  366.         defined = getnum(ifile, "local-ref-map-defined");
  367.         if (!defined) continue;
  368.         n = getnum(ifile, "local-ref-map-size");
  369.         local_ref_map = tup_new(n);
  370.         pUnits[unit]->libInfo.localRefMap = (char *) local_ref_map;
  371.         for (i = 1; i <= n; i += 2) {
  372.             sym = getsymref(ifile, "local-ref-map-sym");
  373.             local_ref_map[i] = (char *) sym;
  374.             off = getnum(ifile, "local-ref-map-off");
  375.             local_ref_map[i+1] = (char *) off;
  376.         }
  377.     }
  378. }
  379.  
  380. static void put_local_ref_maps(IFILE *ofile, int units)    /*;put_local_ref_map*/
  381. {
  382.     int        unit, i, off, n, symbols;
  383.     Symbol    sym;
  384.     Tuple    local_ref_map;
  385.  
  386.     for (unit = 1; unit <= units; unit++) {
  387.         struct unit *pUnit = pUnits[unit];
  388.         local_ref_map = (Tuple) pUnit->libInfo.localRefMap;
  389.         n = tup_size(local_ref_map);
  390.         /* ignore empty ref maps (predef units) and obselete units */
  391.         if (streq(pUnit->libInfo.obsolete, "ok") && n != 0) {
  392.             putnum(ofile, "local-ref-map-defined", 1);
  393.         }
  394.         else {
  395.             putnum(ofile, "local-ref-map-defined", 0);
  396.             continue;
  397.         }
  398.         symbols = pUnit->aisInfo.numberSymbols;
  399.         putnum(ofile, "local-ref-map-size", n);
  400.         for (i = 1; i <= n; i += 2) {
  401.             /* if the sequence num of the symbol is greater than the number of
  402.                 * symbols it is a case of a generated symbol which is not in
  403.              * generated objects. Ignore for now.
  404.              */
  405.             sym = (Symbol) local_ref_map[i];
  406.             if (sym == (Symbol)0 || (S_UNIT(sym)==unit && S_SEQ(sym) >symbols)){
  407.                 putnum(ofile, "ignore", 0);
  408.                 putnum(ofile, "ignore", 0);
  409.                 putnum(ofile, "ignore", 0);
  410.                 continue;
  411.             }
  412.             off = (int) local_ref_map[i+1];
  413.             putsymref(ofile, "local-ref-map-sym", sym);
  414.             putnum(ofile, "local-ref-map-off", off);
  415.         }
  416.     }
  417. }
  418.  
  419. void write_glib()                                            /*;write_glib*/
  420. {
  421.     int        i, j, n, m, nodes, symbols;
  422.     int        unit_count = 0;
  423.     Tuple    stubtup, tup;
  424.     Set        precedes;
  425.     Forset    fs1;
  426.     IFILE    *ofile;
  427.     extern    char *lib_name;
  428.     char    *t_name, *l_name;
  429.  
  430.     n  = unit_numbers; /* number of units */
  431.     l_name = libset(lib_name);
  432.     ofile = ifopen(LIBFILENAME, "", "w", "l", iot_lib_w, 0);
  433.     t_name = libset(l_name);
  434.     LIBFILE = ofile;
  435.     for (i = 1; i <= n; i++) {
  436.         if (!streq(pUnits[i]->libInfo.fname, "0") || compiling_predef)
  437.             unit_count++;
  438.     }
  439.     putnum(ofile, "lib-unit-count", unit_count);
  440.     putnum(ofile, "lib-n", n);
  441.     putnum(ofile, "lib-empty-unit-slots", empty_unit_slots);
  442.     putstr(ofile, "lib-aisname", AISFILENAME);
  443.     for (i = 1; i <= n; i++) {
  444.         struct unit *pUnit =  pUnits[i];
  445.         if (compiling_predef) { /* trace for predef build */
  446.             nodes = pUnit->treInfo.nodeCount;
  447.             symbols = pUnit->aisInfo.numberSymbols;
  448.             printf("predef unit %d %s nodes %d symbols %d\n",
  449.               i, pUnit->name, nodes, symbols);
  450.             if (i <= 14) {
  451.                 /* these checks are meaningless and wrong for any more
  452.                  * than original 14 predef units
  453.                  */
  454.                 if (!streq(pUnit->name, predef_unit_name(i))) {
  455.                     chaos("predef unit name error");
  456.                 }
  457.                 if (nodes != predef_node_count(i)) {
  458.                     printf("WARNING - expect %d nodes, have %d\n",
  459.                       predef_node_count(i), nodes);
  460.                 }
  461.                 if (symbols != predef_symbol_count(i)) {
  462.                     printf("WARNING - expect %d symbol, have %d\n",
  463.                       predef_symbol_count(i), symbols);
  464.                 }
  465.             }
  466.         }
  467.         if (streq(pUnit->libInfo.fname, "0") && !compiling_predef) continue;
  468.         putstr(ofile, "unit-name", pUnit->name);
  469.         putnum(ofile, "unit-number", i);
  470.         putstr(ofile, "libtup-1", pUnit->libInfo.fname);
  471.         putstr(ofile, "unit-date", pUnit->libInfo.compDate);
  472.         if (streq(pUnit->libInfo.obsolete, "$D$")) {
  473.             putnum(ofile, "unit-symbols", 0);
  474.             putnum(ofile, "unit-nodes", 0);
  475.             putnum(ofile, "unit-is-main", 0);
  476.             putnum(ofile, "unit-comp-status", 0);
  477.             continue;
  478.         }
  479.         putnum(ofile, "unit-symbols", pUnit->aisInfo.numberSymbols);
  480.         putnum(ofile, "unit-nodes", pUnit->treInfo.nodeCount);
  481.         putnum(ofile, "unit-is-main", pUnit->isMain);
  482.         putnum(ofile, "unit-comp-status", 1);
  483.     }
  484.     /* write out lib_stub info */
  485.     unit_count = 0;
  486.     n = tup_size(lib_stub);
  487.     for (i = 1; i <= n; i++) if (!streq(lib_stub[i], "$D$")) unit_count++;
  488.     putnum(ofile, "stub-unit-count", unit_count);
  489.     for (i = 1; i <= n; i++) {
  490.         if (streq(lib_stub[i], "$D$")) continue;
  491.         stubtup = (Tuple) stub_info[i];
  492.         putstr(ofile, "stub-libstub", lib_stub[i]);
  493.         putstr(ofile, "stub-stubtup", stubtup[1]);
  494.         putnum(ofile, "stub-parent", (int)stubtup[5]);
  495.         putnum(ofile, "stub-cur-level", (int)stubtup[3]);
  496.         tup = (Tuple) stubtup[4];
  497.         m = tup_size(tup);
  498.         putnum(ofile, "stub-file-size", m);
  499.         for (j = 1; j <= m; j++) {
  500.             putnum(ofile, "stub-files", (int)tup[j]);
  501.         }
  502.     }
  503.     n = tup_size(PRECEDES_MAP);
  504.     putnum(ofile, "precedes-map-size", n);
  505.     for (i = 1; i <= n; i += 2) {
  506.         putnum(ofile, "precedes-map-ent", (int)PRECEDES_MAP[i]);
  507.         precedes = (Set) PRECEDES_MAP[i+1];
  508.         m = set_size(precedes);
  509.         putnum(ofile, "precedes-map-set-size", m);
  510.         FORSET(m = (int), precedes, fs1);
  511.             putnum(ofile, "precedes-map-ent", m);
  512.         ENDFORSET(fs1);
  513.     }
  514.     n = tup_size(compilation_table);
  515.     putnum(ofile, "compilation-table-size", n);
  516.     /* print compilation table (tuple of unit names) */
  517.     for (i = 1; i <= n; i++) {
  518.         putnum(ofile, "compilation-table-ent", (int)compilation_table[i]);
  519.     }
  520.     n = tup_size(late_instances);
  521.     putnum(ofile, "late-instances-size", n);
  522.     /* print late_instances (tuple of unit names) */
  523.     for (i = 1; i <= n; i++) {
  524.         putstr(ofile, "late-instances-ent", late_instances[i]);
  525.     }
  526.     n = tup_size(interfaced_procedures);
  527.     putnum(ofile, "interfaced-procedures-size", n);
  528.     for (i = 1; i <= n; i += 2) {
  529.         putnum(ofile, "interfaced-procedures-num",
  530.           (int) interfaced_procedures[i]);
  531.         putstr(ofile, "interfaced-procedures-str", interfaced_procedures[i+1]);
  532.     }
  533.     putnum(ofile, "interface-counter", interface_counter);
  534.     n = unit_numbers;
  535.     putnum(ofile, "units-size", n);
  536.     for (i = 1; i <= n; i++) {
  537.         putnum(ofile, "current-code-seg", (int) pUnits[i]->libInfo.currCodeSeg);
  538.     }
  539.     putnum(ofile, "unit-size", unit_numbers);
  540.     put_local_ref_maps(LIBFILE, unit_numbers);
  541.     put_cde_slots(LIBFILE, 0);/* write slots info and close file */
  542.     LIBFILE = (IFILE *) 0;
  543. }
  544.  
  545. static void relocate_slots_a()                            /*;relocate_slots_a*/
  546. {
  547.     /* This procedure is the first in the possible relocation of sequence
  548.      * numbers which appear in the Slot field. 
  549.      */
  550.     int     i, n;
  551.     Slot     slot;
  552.  
  553.     n = tup_size(CODE_SLOTS);
  554.     code_slots_syms = tup_new(n);
  555.     for (i = 1; i <= n; i++) {
  556.         slot = (Slot) CODE_SLOTS[i];
  557.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now)
  558.             code_slots_syms[i] = (char *) seq_symbol[slot->slot_seq];
  559.     }
  560.     n = tup_size(DATA_SLOTS);
  561.     data_slots_syms = tup_new(n);
  562.     for (i = 1; i <= n; i++) {
  563.         slot = (Slot) DATA_SLOTS[i];
  564.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now)
  565.             data_slots_syms[i] = (char *) seq_symbol[slot->slot_seq];
  566.     }
  567. }
  568.  
  569. static void relocate_slots_b()                            /*;relocate_slots_b*/
  570. {
  571.     int     i, n;
  572.     Slot     slot;
  573.     Symbol     sym;
  574.  
  575.     n  = tup_size(CODE_SLOTS);
  576.     for (i = 1; i <= n; i++) {
  577.         slot = (Slot) CODE_SLOTS[i];
  578.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now) {
  579.             sym = (Symbol) code_slots_syms[i];
  580.             slot->slot_seq = S_SEQ(sym);
  581.         }
  582.     }
  583.     n = tup_size(DATA_SLOTS);
  584.     for (i = 1; i <= n; i++) {
  585.         slot = (Slot) DATA_SLOTS[i];
  586.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now) {
  587.             sym = (Symbol) data_slots_syms[i];
  588.             slot->slot_seq = S_SEQ(sym);
  589.         }
  590.     }
  591.     tup_free(data_slots_syms);
  592.     tup_free(code_slots_syms);
  593. }
  594.  
  595. void update_stub(Stubenv ev)                                /*;update_stub*/
  596. {
  597.     Tuple   tup;
  598.     Symbol  ev_sym, sym;
  599.     int       i, n;
  600.  
  601.     /* update the SEGMENT and OFFSET fields for procedure symbols since the
  602.      * code generator might have updated their values in a previous unit.
  603.      * Also update  the associated_symbols fields for procedure and packages.
  604.      * Note: this is necessary since for procedures a copy of the symbol is
  605.      * made when the symbol is read into ev_open_decls and therefore some fields
  606.      * might not have been updated when the global symbol accessed by getsymptr
  607.      * is updated.
  608.      * TBSL this might have to be done for packages, and functions.
  609.      */
  610.     tup = ev->ev_open_decls;
  611.     n = tup_size(tup);
  612.     for (i = 1; i <= n; i++) {
  613.         ev_sym = (Symbol) tup[i];
  614.         if (NATURE(ev_sym) == na_procedure) {
  615.             sym = getsymptr(S_SEQ(ev_sym), S_UNIT(ev_sym));
  616.             S_SEGMENT(ev_sym) = S_SEGMENT(sym);
  617.             S_OFFSET(ev_sym) = S_OFFSET(sym);
  618.         }
  619.         if (NATURE(ev_sym) == na_package || NATURE(ev_sym) == na_procedure) {
  620.             sym = getsymptr(S_SEQ(ev_sym), S_UNIT(ev_sym));
  621.             if (ASSOCIATED_SYMBOLS(sym) != (Tuple)0)
  622.                 ASSOCIATED_SYMBOLS(ev_sym) = ASSOCIATED_SYMBOLS(sym);
  623.         }
  624.     }
  625. }
  626.  
  627. static void overwrite_stub_name(char *uname)            /*;overwrite_stub_name*/
  628. {
  629.     /* If a stub and its proper body are in the same compilation, this 
  630.      * procedure is called. Normally the code generator write the st2 file
  631.      * after the unit constaining the stub is processed. If the proper body
  632.      * then appears later in the compilation, we must go back to where the 
  633.      * info for the stub was written and change its name so that only the
  634.      * second appearance (proper body) is recognized.
  635.      */
  636.     long  str_pos, rec;
  637.     char  *funame;
  638.     IFILE *ifile;
  639.  
  640.     ifclose(STUBFILE);
  641.     STUBFILE = ifopen(AISFILENAME, "st2", "r+", "s", iot_ais_w, 0);
  642.     ifile = STUBFILE;
  643.     for (rec = read_init(ifile); rec != 0; rec = read_next(ifile, rec)) {
  644.         str_pos = iftell(ifile);
  645.         funame = getstr(ifile, "stub-name");
  646.         if (!streq(uname, funame)) continue;
  647.         ifseek(ifile, "seek to string", str_pos, 0);
  648.         funame[0] = '$';
  649.         putstr(ifile, "stub-name", funame);
  650.         break;
  651.     }
  652.     ifseek(ifile, "seek to end", 0L, 2);
  653.     ifile->fh_mode = 'w';
  654. }
  655.  
  656. void overwrite_unit_name(char *uname)                /*;overwrite_unit_name*/
  657. {
  658.     /* If a compilation unit appears more than once in the same compilation,
  659.      * this procedure is called.  The code for the first occurrence must be
  660.      * disabled. This is done by going back to where the info for the unit was
  661.      * written and change its name so that only the second appearance is
  662.      * recognized.
  663.      */
  664.     long  str_pos, rec;
  665.     char  *funame;
  666.     IFILE *ifile;
  667.  
  668.     ifclose(AXQFILE);
  669.     AXQFILE = ifopen(AISFILENAME, "axq", "r+", "a", iot_ais_w, 0);
  670.     ifile = AXQFILE;
  671.     for (rec = read_init(ifile); rec != 0; rec = read_next(ifile, rec)) {
  672.         str_pos = iftell(ifile);
  673.         funame = getstr(ifile, "unit-name");
  674.         if (!streq(uname, funame)) continue;
  675.         ifseek(ifile, "seek to string", str_pos, 0);
  676.         funame[0] = '$';
  677.         putstr(ifile, "unit-name", funame);
  678.         break;
  679.     }
  680.     ifseek(ifile, "seek to end", 0L, 2);
  681.     ifile->fh_mode = 'w';
  682. }
  683.  
  684. int read_stub_short(char *fname, char *uname, char *ext)    /*;read_stub_short*/
  685. {
  686.     long    rec;
  687.     Stubenv    ev;
  688.     int        i, j, k, n, m, si;
  689.     char    *funame;
  690.     Tuple    stubtup, tup, tup2, tup3;
  691.     int        ci, cn;
  692.     Tuple    cent, ctup, cntup;
  693.     Symbol    sym;
  694.     int        retrieved = FALSE;
  695.     IFILE    *ifile;
  696.  
  697.     /* This is a modifed version of read_stub which only reads enough
  698.      * information from the stubfile so that it can be rewritten. Notably it
  699.      * reads just the symbol references and not the full symbol definitions.
  700.      * It is called from gen_stub.
  701.       */
  702.  
  703.     /* open so do not fail if no file */
  704.     ifile = ifopen(fname, ext, "r", "s", iot_ais_r, 1);
  705.     if (ifile == (IFILE *)0) { /* if not stub file */
  706.         return retrieved;
  707.     }
  708.     for (rec = read_init(ifile); rec != 0; rec = read_next(ifile, rec)) {
  709.         funame = getstr(ifile, "stub-name");
  710.         if (uname != (char *)0  && !streq(uname, funame)) continue;
  711.         si = stub_number(funame);
  712.         if (uname == (char *)0) lib_stub_put(funame, fname);
  713.         ev = stubenv_new();
  714.         stubtup = (Tuple) stub_info[si];
  715.         stubtup[2] = (char *) ev;
  716.         n = getnum(ifile, "scope-stack-size");
  717.         tup = tup_new(n);
  718.         for (i = 1; i <= n; i++) {
  719.             tup2 = tup_new(4);
  720.             tup2[1] = (char *) getsymref(ifile, "scope-stack-symref");
  721.             for (j = 2; j <= 4; j++) {
  722.                 m = getnum(ifile, "scope-stack-m");
  723.                 tup3 = tup_new(m);
  724.                 for (k = 1; k <= m; k++)
  725.                     tup3[k] = (char *) getsymref(ifile, "scope-stack-m-symref");
  726.  
  727.                 tup2[j] = (char *) tup3;
  728.             }
  729.             tup[i] = (char *) tup2;
  730.         }
  731.         ev->ev_scope_st = tup;
  732.         ev->ev_unit_unam = getsymref(ifile, "ev-unit-name-symref");
  733.         ev->ev_decmap = getdcl(ifile);
  734.  
  735.         /* unit_nodes */
  736.         n = getnum(ifile, "ev-nodes-size");
  737.         tup = tup_new(n);
  738.         for (i = 1; i <= n; i++) {
  739.             tup[i] = (char *) getnodref(ifile, "ev-nodes-nodref");
  740.         }
  741.         ev->ev_nodes = tup;
  742.  
  743.         /* context */
  744.         n = getnum(ifile, "stub-context-size");
  745.         if (n>0) {
  746.             n -= 1; /* true tuple size */
  747.             ctup = tup_new(n);
  748.             for (i = 1; i <= n; i++) {
  749.                 cent = (Tuple) tup_new(2);
  750.                 cent[1] = (char *) getnum(ifile, "stub-cent-1");
  751.                 cn = getnum(ifile, "stub-cent-2-size"); 
  752.                 cntup = tup_new(cn);
  753.                 for (ci = 1; ci <= cn; ci++) {
  754.                     cntup[ci] = getstr(ifile, "stub-cent-2-str");
  755.                 }
  756.                 cent[2] = (char *) cntup;
  757.                 ctup[i] = (char *) cent;
  758.             }
  759.             ev->ev_context =  ctup;
  760.         }
  761.         /* tuple of symbol table pointers */
  762.         n = getnum(ifile, "ev-open-decls-size");
  763.         if (n > 0) {
  764.             n -= 1; /* true tuple size */
  765.             tup = tup_new(n);
  766.             for (i = 1; i <= n; i++) {
  767.                 sym = getsymref(ifile, "ev-open-decls-sym");
  768.                 tup[i] = (char *) sym;
  769.             }
  770.             ev->ev_open_decls = tup;
  771.         }
  772.         ev->ev_relay_set = tup_new(0);
  773.         ev->ev_dangling_relay_set = tup_new(0);
  774.         retrieved = TRUE;
  775.         if (uname != (char *)0)  break;
  776.     }
  777.     ifclose(ifile);
  778.     return retrieved;
  779. }
  780.  
  781. void retrieve_generic_body(Symbol sym)                /*;retrieve_generic_body*/
  782. {
  783.     Symbol    scope_of_sym;
  784.     char    *uname, *fname;
  785.  
  786.     scope_of_sym = SCOPE_OF(sym);
  787.     if (scope_of_sym == symbol_standard0) return;
  788.     while (scope_of_sym != symbol_standard0) {
  789.         sym = scope_of_sym;
  790.         scope_of_sym = SCOPE_OF(sym);
  791.     }
  792.     if (NATURE(sym) == na_package_spec) {
  793.         uname = strjoin("bo", ORIG_NAME(sym));
  794.         fname = lib_unit_get(uname);
  795.         if (fname == (char *)0) { /* body not present in library */
  796.             return;
  797.         }
  798.         /* unit read already or predefined unit which is not necessary to read*/
  799.         else if (in_aisunits_read(uname) || streq(fname, "0")) {
  800.             return;
  801.         }
  802.         /* accessing unit within the same files */
  803.         else if (streq(fname, AISFILENAME)) {
  804.             return;
  805.         }
  806.         read_ais(fname, FALSE, uname, 0, FALSE);
  807.     }
  808. }
  809.  
  810. void collect_stub_node_units(int si)                /*;collect_stub_node_units*/
  811. {
  812.     /*
  813.      * Collect the unit numbers which potentially have nodes in them that are
  814.      * referenced by the open_decls (symbol table) of the .st1 file for the
  815.      * stub "si". This information will be used to retrieve the tree nodes when
  816.      * the proper body is seen.
  817.      */
  818.  
  819.     Stubenv ev;
  820.     Tuple   tup, units_tup, stubtup;
  821.     Symbol  sym;
  822.     int        i, n;
  823.  
  824.     stubtup = (Tuple) stub_info[si];
  825.     ev = (Stubenv) stubtup[2];
  826.     tup = ev->ev_open_decls;
  827.     n = tup_size(tup);
  828.     units_tup = tup_new(0);
  829.     for (i = 1; i <= n; i++) {
  830.         sym = (Symbol) tup[i];
  831.         if (!tup_mem((char *)S_UNIT(sym), units_tup))
  832.             units_tup = tup_with(units_tup, (char *)S_UNIT(sym));
  833.     }
  834.     stubtup[4] = (char *) units_tup;
  835. }
  836.